Pascal Super Library/Pascal Super Library (CW International)(1997).bin/PGM_TOOL/RLINE_OP/MOVEOPS.PAS

Pascal/Delphi Source File | 1989-10-10 | 8KB | 363 lines

{$A+,B-,D+,E-,F-,I-,L+,N-,O-,R-,S-,V-}
{$M 16384,0,655360}
UNIT MoveOps;

{ Objects to move around in a rectangle. }

(***************************************)
INTERFACE
(***************************************)

USES
  CRT, DOS;

TYPE
  Str80 = string[80];

  Rectangle = Object
        x1,y1,x2,y2 : integer;
        Height,Width : Integer;
        PROCEDURE Init(px1,py1,px2,py2 : integer);
          END;

  ScreenR = object(Rectangle)
        IxNoY1 : LongInt;
        TotalItems : LongInt;     { Total number of items. }
        FirstColumn : Integer;    { First column displayed. }
        Constructor Init(px1,py1,px2,py2 : integer;
                   TotItems : LongInt);
        FUNCTION DTAline(Row : LongInt) : String; virtual;
        { Returns string at Row }
        PROCEDURE WrScrLn(Y : Integer); virtual;
        { Write the proper string at SCREEN line Y }
        PROCEDURE PgUp;
        PROCEDURE PgDn;
        PROCEDURE TOFL;
        PROCEDURE EOFL;  virtual;
        PROCEDURE ScrollUp;
        PROCEDURE ScrollDown;
        PROCEDURE MoveLeft(i : Integer);
        PROCEDURE MoveRight(i : Integer);
        PROCEDURE WrScr;   { writes entire screen. }
        PROCEDURE GotoLine(X : LongInt);
        Destructor Done;
          END;

  Scroller = object(ScreenR)
        SearchString : string[80];
        CaseSensitive : Boolean;
        Constructor Init(px1,py1,px2,py2 : integer;
                   TotItems : LongInt);
        PROCEDURE ShowStatus; virtual;
        PROCEDURE Help; virtual;
        PROCEDURE AutoScroll;
        FUNCTION ScrollSelect : Char; virtual;
        FUNCTION AskString(prompt : string) : string; virtual;
        PROCEDURE Message(s : str80); Virtual;
        PROCEDURE SearchForward; virtual;
          END;

  PROCEDURE UpCaseString(var s : string);
  FUNCTION InsensitiveMatch(var s1,s2 : string) : boolean;


(*****************************************************)
implementation
(*****************************************************)

{-------- Rectangle -------------}

  PROCEDURE Rectangle.Init(px1,py1,px2,py2 : integer);
  BEGIN
    x1 := px1;
    y1 := py1;
    x2 := px2;
    y2 := py2;
    height := y2-y1+1;
    width := x2-x1+1;
  END;

  Constructor ScreenR.Init(px1,py1,px2,py2 : integer;
            TotItems : LongInt);
  BEGIN
    Rectangle.Init(px1,py1,px2,py2);
    TotalItems := TotItems;
    IxNoY1 := 1;
    FirstColumn := 1;
  END;

  Destructor ScreenR.Done;  BEGIN  END;

  FUNCTION ScreenR.DTAline(Row : LongInt) : String;
  { responsible for returning line at 'Row'.  }
  { If Row < 1 or > TotalItems, returns '' blank string. }
  BEGIN
    runerror(211);
  END;

  PROCEDURE ScreenR.WrScrLn(Y : Integer);
  VAR
    s : string;
  BEGIN              { WrScrLn }
    s := DTALine(Pred(Y + IxnoY1));
    s := copy(s, FirstColumn, width);
    if length(s) < width then BEGIN
      fillchar(s[length(s)+1], width-length(s), ' ');
      s[0] := char(width);
    END;
    gotoxy(x1, pred(Y+y1));
    if wherey = 25
    then dec(s[0]);     { avoid scrolling the window writing at last column }
    write(s)
  END;

  PROCEDURE ScreenR.WrScr;
  VAR
    cy        : Integer;
  BEGIN
    FOR cy := 1 TO Height
    DO WrScrLn(cy);
  END;

  PROCEDURE ScreenR.ScrollUp;
  var
   r : registers;
  BEGIN
    IF Pred(IxNoY1+Height) < TotalItems THEN BEGIN
      Inc(IxNoY1);
      IF Height > 1 then with r do BEGIN
    ax := $0601;  { scroll window, 1 line. }
    bh := textattr;
    ch := pred(y1);
    cl := pred(x1);
    dh := pred(y2);
    dl := pred(x2);
    intr($10,r);
      END;
      WrScrLn(Height);
    END;
  END;

  PROCEDURE ScreenR.ScrollDown;
  var
    r : registers;
  BEGIN
    IF IxNoY1 <> 1 THEN BEGIN
      Dec(IxNoY1);
      IF Height > 1 then with r do BEGIN
    ax := $0701;  { scroll window, 1 line. }
    bh := textattr;
    ch := pred(y1);
    cl := pred(x1);
    dh := pred(y2);
    dl := pred(x2);
    intr($10,r);
      END;
      WrScrLn(1);
    END;
  END;

  PROCEDURE ScreenR.MoveLeft(i : Integer);
  BEGIN
    Dec(FirstColumn,i);
    If FirstColumn < 1
    Then FirstColumn := 1;
    WrScr;
  END;

  PROCEDURE ScreenR.MoveRight(i : Integer);
  BEGIN
    Inc(FirstColumn,i);
    If FirstColumn > 255-width
    Then Firstcolumn := 255-width;
    WrScr;
  END;

  PROCEDURE ScreenR.TOFL;         { ^A }
  BEGIN
    IxNoY1 := 1;
    FirstColumn := 1;
    WrScr;
  END;

  PROCEDURE ScreenR.EoFL;
  BEGIN
    IF TotalItems >= Height
    THEN IxnoY1 := Succ(TotalItems-Height)
    ELSE IxnoY1 := 1;
    WrScr;
  END;

  PROCEDURE ScreenR.PgUp;
  BEGIN         { PgUp }
    IF IxNoY1 > Height
    THEN Dec(IxNoY1, Height)
    ELSE IxnoY1 := 1;
    WrScr;
  END;

  PROCEDURE ScreenR.PgDn;
  BEGIN         { PgDn }
    IF Pred(IxNoY1)+(Height*2) <= Pred(TotalItems) THEN BEGIN
      Inc(IxNoY1, Height);
      WrScr;
    END ELSE EOFl;
  END;

  PROCEDURE ScreenR.GotoLine(X : LongInt);
  BEGIN
    IxnoY1 := X;
    wrscr;
  END;

{ SCROLLER ------------------------------------------------------}

  Constructor Scroller.Init(px1,py1,px2,py2 : integer;
            TotItems : LongInt);
  BEGIN
    ScreenR.Init(px1,py1,px2,py2,TotItems);
    SearchString := '';
    CaseSensitive := false;
  END;

  FUNCTION Scroller.AskString(prompt : string) : string;
  BEGIN
    AskString := '';
  END;

  PROCEDURE Scroller.ShowStatus;  BEGIN END;
  PROCEDURE Scroller.Message(s : Str80); BEGIN END;
  PROCEDURE Scroller.Help;  BEGIN END;

  PROCEDURE UpCaseString(var s : string);
  var
    i : integer;
  BEGIN
    for i := 1 to length(s) do s[i] := upcase(s[i]);
  END;

  FUNCTION InsensitiveMatch(var s1,s2 : string) : boolean;
  { s1 should be upper cased. }
  var
    i, j, k : integer;
    len : integer;
  BEGIN
    i := pos(s1[1],s2);
    j := pos(chr(ord(s1[1])+32), s2);
    IF (i or j) <> 0 THEN BEGIN
      if ((i > 0) and (i < j)) or (j = 0)
      then j := i;
      for i := j to length(s2)-length(s1)+1 do
    if upcase(s2[i]) = s1[1] then BEGIN
      j := 2;
      k := succ(i);
      while (j <= length(s1)) and (s1[j] = upcase(s2[k])) do BEGIN
        inc(k);
        inc(j);
      END;
      if j > length(s1) then BEGIN
        InsensitiveMatch := true;
        Exit;
      END;
    END;
    END;
    InsensitiveMatch := false;
  END;

  PROCEDURE Scroller.SearchForward;
  var
   i : longint;
   s2 : string;
   j,k : integer;
  BEGIN
    if length(SearchString) = 0 then Exit;
    Message('Searching forward for "'+searchstring+'"');
    if not casesensitive then BEGIN
      for i := IxnoY1+1 to totalitems do BEGIN
    s2 := dtaline(i);
    if InsensitiveMatch(SearchString,s2) then BEGIN
      GotoLine(i);
      Exit;
    END;
      END;
    END ELSE BEGIN { case sensitive }
      for i := Ixnoy1+1 to totalitems do BEGIN
    if pos(SearchString,dtaline(i)) <> 0 then BEGIN
      GotoLine(i);
      Exit;
    END;
      END;
    END;
    Message('"'+SearchString+'" Not Found.  Press any key');
    while Readkey = #0 do;
  END;


  PROCEDURE Scroller.AutoScroll;
  Const
    DelayMul = 150;
    Dlay : Integer = 5 * DelayMul;
  Var
    Finished : Boolean;
    ch : char;
    i : integer;
  BEGIN
    Finished := False;
    While Not Finished AND (IxnoY1 < TotalItems-Height) Do BEGIN
      If Keypressed Then BEGIN
    i := pos(ReadKey, '0123456789');
    if i > 0
    Then Dlay := i * DelayMul
    Else Finished := True;
      End Else BEGIN
        ScrollUp;
        ShowStatus;
    Delay(Dlay);
      END;
    END;
  END;

  FUNCTION Scroller.ScrollSelect : Char;
  { scroll through file until an invalid key is pressed. }
  VAR
    Ch : Char;
    Finished : Boolean;
  BEGIN
    Finished := False;
    REPEAT
      ShowStatus;
      Ch := ReadKey;
      If Ch = #0 Then BEGIN
        Ch := ReadKey;
    Case Ch OF
      #59  : Help;
      #80 : ScrollUp;
      #72 : ScrollDown;
      #77 : MoveRight(1);
      #75 : MoveLeft(1);
      #115 : MoveLeft(8);
      #116 : MoveRight(8);
      #73 : PgUp;
      #81 : PgDn;
      #71 : TOFL;
      #79 : EOFl;
        ELSE Finished := True;
    END;
      END ELSE CASE UpCase(Ch) OF
    'F','C' : BEGIN
            SearchString := AskString('Search for:');
            CaseSensitive := Ch in ['C','c'];
            IF Not CaseSensitive
            THEN UpCaseString(SearchString);
            SearchForward;
          END;
    'N' : SearchForward;
    'A' : AutoScroll;
        ELSE Finished := True;
      END;
    UNTIL Finished;
    ScrollSelect := Ch;
  END;

END.